perm filename DPY.F4[LIB,LCS] blob
sn#089348 filedate 1974-02-23 generic text, type T, neo UTF8
00001 C LOAD WITH PCALL.FAI -- 'LIBRY' HAS LIST OF FILES.
00002 C 'P' REPLAYS; '+N' GOES TO NEXT; '-N' BACKS UP.
00100 C 'ALL' PLAYS ALL UNDER A COMPOSER HEADING.
00300 DIMENSION J(2000),NWK(21),INP(21)
00310 CALL TYPLOC(-250,-511)
00320 NX=' '
00400 1 FORMAT(' COMPOSER? ',$)
00410 201 FORMAT(A1)
00500 2 FORMAT(A5)
00510 7 FORMAT(20A1,A5)
00515 NCNT=0
00520 C LIBRY MUST PUT FILE NAME AT 21st SPACE.
00600 10 TYPE 1
00620 NUMX=0
00630 ACCEPT 2,NCMP
00640 REREAD 201,IX
00701 REREAD 200,NUM
00702 IF(IX.EQ.'+')GO TO 41
00705 IF(NCMP.EQ.' ')NCMP=NX
00707 IF(NCMP.EQ.' ')NCMP='BACH'
00708 C FOR DEMO
00710 IF(NCMP.EQ.'P')GO TO 11
00712 IF(IX.EQ.'-')GO TO 14
00715 NX=NCMP
00717 9 CALL IFILE(1,'LIBRY')
00718 IF(IX.EQ.'-')GO TO 16
00720 3 READ(1,20,END=5)K,NM
00740 NCNT=NCNT+1
00760 IF(NM.NE.NX)GO TO 3
00800 TYPE 12
00900 12 FORMAT(' NAME OF WORK? ',$)
00910 20 FORMAT(I,A5)
01000 ACCEPT 7,NWK
01100 13 FORMAT(I,20A1,1A5)
01110 JT=WDNM(NWK)
01115 NW=0
01120 IF(NWK(1).EQ.'A'.AND.NWK(2).EQ.'L'.AND.NWK(3).EQ.'L')NW='ALL'
01137 C JT=NUMERICAL VALUE OF NAME OF WORK
01140 4 READ(1,13,END=5)K,INP
01142 NCNT=NCNT+1
01143 IF(NCNT.LT.NUMX)GO TO 4
01145 IF(IX.EQ.'+'.OR.NW.EQ.'ALL')GO TO 40
01147 C TYPE 'N' FOR NEXT ITEM IN LIST.
01150 IT=WDNM(INP)
01160 IF(IT.NE.JT)GO TO 4
01170 C GO BACK IF NOT FOUND
02000 40 NM=INP(21)
02100 CALL IFILE(21,NM)
06010 CALL DPYSET(1,J,2000)
06020 READ(21)K,(J(N),N=1,K+2)
06030 CALL ACCPOG(1)
06050 CALL DPYOUT(1)
06060 11 CALL PLAY(NM,1,3)
06065 IF(NW.EQ.'ALL')GO TO 4
06070 GO TO 10
06080 5 TYPE 6
06085 NCNT=0
06090 GO TO 10
06100 6 FORMAT(' NOT FOUND'/)
06110 14 IF(NUM.EQ.0)NUM=-1
06210 NCNT=NCNT+NUM
06300 GO TO 9
07000 16 DO 15 K=1,NCNT
07100 15 READ(1,13)IT,INP
07200 GO TO 40
07400 41 IF(NUM.EQ.0)NUM=1
07500 NUMX=NUM+NCNT
07600 GO TO 4
07650 200 FORMAT(I)
07700 END
09900
10000 C GIVES NUMERICAL VALUE TO LETTER STRING
10100 FUNCTION WDNM(I)
10200 DIMENSION I(1)
10300 N=0
10400 DO 1 K=1,20
10500 IF(I(K).EQ.' ')GO TO 1
10600 N=N+(I(K)-'A')/536870912
10700 1 CONTINUE
10800 WDNM=N
10900 END